home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / pc / LOGIC Apple II 5.25" Library - DOS Part 7 / DOS226.dsk / LISTS.bas < prev    next >
BASIC Source File  |  2012-02-16  |  31KB  |  523 lines
  1. 0  REM FAMILY ROOTS: LISTS PROGRAM. COPYRIGHT 1982, STEPHEN C. VORENBERG
  2. 40  CLEAR : GOTO 16000
  3. 100 JJ =  LEN(NE$(W)):KK = 0:N1$ = "":N2$ = "":N3$ = "":N4$ = "": IF JJ = 0  THEN 320
  4. 110  FOR II =  LEN(NE$(W)) TO 1  STEP  -1: IF  MID$ (NE$(W),II,1) < >Q$(5)  THEN 300
  5. 120 KK = KK +1: IF II -JJ = 0  THEN 200
  6. 130  ON KK GOTO 160,150,140
  7. 140 N1$ =  MID$ (NE$(W),II +1,JJ -II): GOTO 200
  8. 150 N2$ =  MID$ (NE$(W),II +1,JJ -II): GOTO 200
  9. 160 N4$ =  RIGHT$(NE$(W),JJ -II)
  10. 200 JJ = II -1: IF KK = 3  THEN II = 1
  11. 300  NEXT : IF JJ -II >0  THEN N3$ =  LEFT$(NE$(W),JJ -II)
  12. 310  IF KK = 2  THEN N1$ = N2$:N2$ = N3$:N3$ = ""
  13. 320  RETURN 
  14. 400 A = NB(I):NB(I) = NB(II):NB(II) = A: RETURN 
  15. 410 ID = 2
  16. 420 ID = ID *2: IF ID < = NB  THEN 420
  17. 430 ID = ID -1
  18. 440 ID =  INT(ID/2): IF ID <1  THEN  GOSUB 9950: RETURN 
  19. 450  HTAB 30: VTAB 23: PRINT "ID="ID"  ":JJ = NB -ID: FOR M = 1 TO JJ:I = M
  20. 460 II = I +ID
  21. 470  IF NE$(NB(II)) >NE$(NB(I))  THEN 500
  22. 480  IF OP(12)  THEN  IF  PEEK( -16384) =  ASC(CZ$) +128  THEN  POKE  -16368,0:ES = 1:ID = 1: RETURN 
  23. 490  GOSUB 400:I = I -ID: IF I > = 1  THEN 460
  24. 500  NEXT 
  25. 510  GOTO 440
  26. 580  IF   NOT Q(1)  THEN  RETURN 
  27. 581  IF Q(41) >2  THEN  PRINT  CHR$(27) CHR$(17)
  28. 582 FC = Q(23) *Q(Q(6)) -1: PRINT  CHR$(4)"PR#"Q(3): ON Q(1) GOTO 586,583
  29. 583  IF Q$(1) < >""  OR Q$(Q(7)) < >""  THEN  PRINT Q$(1)Q$(Q(7))
  30. 584  RETURN 
  31. 586  PRINT Q$(1)Q$(Q(7));: RETURN 
  32. 600  IF   NOT Q(1)  THEN  RETURN 
  33. 601 FC = Q(22): IF Q$(2) < >""  THEN  PRINT Q$(2)
  34. 602  PRINT  CHR$(4)"PR#"Q(43): RETURN 
  35. 640  IF  PEEK( -16384) =  ASC(CZ$) +128  THEN X = Q(28):Y = X:XY = X: POKE  -16368,0:ES = 1
  36. 642  RETURN 
  37. 680 TB = 0: IF   NOT OP(5)  THEN 686
  38. 682 TB = OP(2): IF TB >50  THEN TB = 50
  39. 683  IF TB <1  THEN TB = 1
  40. 684  IF OP(11) <1  THEN OP(11) = 1
  41. 685  IF OP(11) >100  THEN OP(11) = 100
  42. 686  IF OP(4) <0  THEN OP(4) = 0
  43. 687  IF OP(4) >120  THEN OP(4) = 50
  44. 689  RETURN 
  45. 690  GET YN$: POKE  -16368,0: NORMAL : PRINT YN$: IF  ASC(YN$) >95  THEN YN$ =  CHR$( ASC(YN$) -32)
  46. 691  RETURN 
  47. 695  PRINT "TYPE ANY KEY TO CONTINUE";: GOSUB 690: RETURN 
  48. 740  PRINT H$(C1)" BY "H1$(2):X3 = 1:Z = 0:B$ = "FIRST "
  49. 745  PRINT B$;: INPUT "NUMBER? ";A$: IF A$ = ""  THEN 778
  50. 750  IF A$ = "P"  THEN  GOSUB 1600: GOSUB 850: GOTO 745
  51. 755  IF A$ = CZ$  THEN LO = 0: RETURN 
  52. 760 A =  VAL(A$): IF A <1  OR A >G(2)  THEN  PRINT "OUT OF RANGE. ID'S MUST BE BETWEEN 1";: GOSUB 860: PRINT "AND "G(2)".": GOTO 745
  53. 762 Z = Z +1:SV(Z) = A:B$ = "NEXT ":W = A: GOSUB 2400
  54. 765  GOSUB 3500
  55. 767 X = SV(Z): GOSUB 3550: FOR X = PA +1 TO SV(Z): INPUT NE$(Z): NEXT 
  56. 770  PRINT  CHR$(4)"CLOSE": GOSUB 800
  57. 777  IF Z <SZ  THEN 745
  58. 778 LO = Z: IF LO = 0  THEN  RETURN 
  59. 780  ON C1 GOSUB 9510,5500: RETURN 
  60. 800  IF  LEN(NE$(Z)) >3  THEN 815
  61. 805  IF   NOT OP(9)  THEN Z = Z -1
  62. 810  RETURN 
  63. 815  PRINT "SAVING ID="SV(Z): IF OP(8)  AND   NOT OP(7)  THEN  RETURN 
  64. 820 W = Z: GOSUB 100: IF N3$ = ""  THEN  RETURN 
  65. 825  IF OP(8)  AND OP(7)  AND Z <SZ  THEN Z = Z +1:SV(Z) = SV(Z -1)
  66. 830 NE$(Z) = N2$ +Q$(5) +N1$ +Q$(5) +N4$: RETURN 
  67. 850  PRINT : IF Q(43) = 0  OR Q(40)  THEN  HOME : RETURN 
  68. 860  PRINT  CHR$(12): RETURN 
  69. 1000  INPUT "START NUMBER? ";A$: IF A$ = ""  THEN  RETURN 
  70. 1010  IF A$ = "P"  THEN  GOSUB 1600: GOSUB 850: GOTO 1000
  71. 1020 X3 =  VAL(A$): IF X3 <1  THEN X3 = 1
  72. 1025  IF X3 >G(2)  THEN  PRINT : PRINT "THE DEMO DISK CAN ONLY ACCOMMODATE";: GOSUB 860: PRINT G(2)" NAMES.": PRINT : GOTO 1000
  73. 1030  INPUT "END NUMBER? ";A$: IF A$ = "P"  THEN  GOSUB 1600: GOSUB 850: PRINT "START WAS "X3: GOTO 1030
  74. 1040  IF A$ = CZ$  THEN  RETURN 
  75. 1045  IF  VAL(A$) >G(2)  THEN  PRINT : PRINT "THE DEMO DISK CAN ONLY ACCOMMODATE";: GOSUB 860: PRINT G(2)" NAMES.": PRINT : GOTO 1030
  76. 1050 LO = 0:X4 =  VAL(A$): IF X4 <X3  THEN X4 = X3
  77. 1070 Z = 0:W = X3: GOSUB 2400:X5 = X4
  78. 1080 X6 =  INT(X3/G(2)) *G(2): IF X5 >X6 +G(2)  THEN X5 = G(2) + INT(X3/G(2)) *G(2)
  79. 1090  GOSUB 3500
  80. 1100  FOR X =  INT((X3 -1)/Q(36)) *Q(36) +1 TO  INT((X5 -1)/Q(36)) *Q(36) +Q(36)  STEP Q(36): GOSUB 3550
  81. 1110  FOR Y = PA +1 TO PA +Q(36): IF Y <X3  THEN  INPUT A$: GOTO 1190
  82. 1120  IF Y >X5  THEN 1190
  83. 1125  IF Z <SZ  THEN Z = Z +1: INPUT NE$(Z):SV(Z) = Y: GOSUB 800
  84. 1180  IF Z >SZ -2  THEN X = X4:Y = X: PRINT Z" NAMES STORED": FOR I = 1 TO 2000: NEXT 
  85. 1190  NEXT : PRINT  CHR$(4): GOSUB 640
  86. 1200  NEXT : PRINT  CHR$(4)"CLOSE": IF X5 <X4  THEN X3 = X5 +1:W = X3: GOSUB 2400:X5 = X4: GOTO 1080
  87. 1210 LO = Z: IF ES  OR LO = 0  THEN  RETURN 
  88. 1220  ON C1 GOSUB 9510,5500: RETURN 
  89. 1260  IF Q(9) >0  THEN  CALL G(0)
  90. 1265  PRINT H$(C1)" WITH ALL THE": PRINT "FOLLOWING-ENTERED NAMES IN COMMON:": PRINT  TAB( 5)"--LAST NAME AT BIRTH";: INPUT NL$
  91. 1280  PRINT  TAB( 5)"--FIRST NAME(S)";: INPUT NF$: PRINT  TAB( 5)"--MARRIED NAME";: INPUT NM$: PRINT 
  92. 1285  IF NF$ +NL$ +NM$ = ""  THEN  RETURN 
  93. 1395 LO = 0: GOSUB 1540:Z = 1: FOR XY = 1 TO Q(8): IF WH(XY,0) <0  THEN 1525
  94. 1400 W = WH(XY,0) +1: GOSUB 2400: GOSUB 3500
  95. 1402  FOR X = WH(BB,0) +1 TO WH(BB,0) +G(2)  STEP Q(36): GOSUB 3550
  96. 1404  FOR Y = PA +1 TO PA +Q(36): INPUT NE$(Z)
  97. 1405 W = Z: GOSUB 100: IF NL$ = ""  THEN 1420
  98. 1407  IF OP(14)  THEN A$ = N2$: GOSUB 1900:N2$ = B$
  99. 1410  IF NL$ < >N2$  THEN 1520
  100. 1420  IF NM$ = ""  THEN 1440
  101. 1425  IF OP(14)  THEN A$ = N3$: GOSUB 1900:N3$ = B$
  102. 1430  IF NM$ < >N3$  THEN 1520
  103. 1440  IF NF$ = ""  THEN 1460
  104. 1445  IF OP(14)  THEN A$ = N1$: GOSUB 1900:N1$ = B$
  105. 1450 M = 0:A =  LEN(N1$) - LEN(NF$): IF A <0  THEN 1520
  106. 1452 II = A +1
  107. 1454  IF NF$ =  MID$ (N1$,II, LEN(NF$))  THEN M = II
  108. 1456 II = II -1: IF II >0  THEN 1454
  109. 1458  IF M = 0  THEN 1520
  110. 1460 SV(Z) = Y: GOSUB 800:Z = Z +1: IF Z = SZ  THEN X = Q(28):Y = X:XY = Q(8)
  111. 1520  GOSUB 640: NEXT : NEXT : PRINT  CHR$(4)"CLOSE"
  112. 1525  NEXT XY:LO = Z -1: POKE 34,0: IF ES  OR LO = 0  THEN  RETURN 
  113. 1530  ON C1 GOSUB 9510,5500: RETURN 
  114. 1540  GOSUB 7100: PRINT "SEARCHING NAMES": RETURN 
  115. 1600 SP = 2
  116. 1602 EP = SP +12: IF EP >OP +1  THEN EP = OP +1
  117. 1605  POKE 34,0: GOSUB 850: INVERSE : PRINT "SELECT PARAMETER BY LETTER:": NORMAL : PRINT : PRINT "A) FIRST VISIBLE PARAMETER (NOW " CHR$(64 +SP)")"
  118. 1610 K = 1: FOR I = SP TO EP:K = K +1: PRINT  CHR$(64 +I)") "OP$(I -1)" (NOW "OP(I -1)")": IF  INT(K/4) *4 = K  THEN  PRINT 
  119. 1614  NEXT :J = EP: IF DY$ < >""  AND EP = OP +1  THEN J = J +1: PRINT  CHR$(64 +J)") DATE (NOW "DY$")"
  120. 1615  PRINT : PRINT "(NOTE: 0='FALSE',1='TRUE')"
  121. 1618 KK = OP +2: IF DY$ = ""  THEN KK = KK -1
  122. 1620  PRINT : INVERSE : PRINT "WHICH (A-" CHR$(64 +KK)")?";: GOSUB 690
  123. 1628  IF YN$ =  CHR$(13)  THEN  RETURN 
  124. 1630 A =  ASC(YN$) -64: IF A <1  OR A >KK  THEN 1620
  125. 1632  IF DY$ < >""  AND A = KK  THEN 1660
  126. 1635  IF A >1  THEN  PRINT OP$(A -1)"?";: GOTO 1640
  127. 1636  PRINT "FIRST VISIBLE PARAMETER?";: GOSUB 690:B$ = YN$: IF B$ =  CHR$(13)  THEN 1602
  128. 1637  IF B$ <"B"  THEN B$ = "B"
  129. 1638  IF B$ > CHR$(65 +OP)  THEN B$ =  CHR$(65 +OP)
  130. 1639 SP =  ASC(B$) -64: GOTO 1602
  131. 1640  GET B$: POKE  -16368,0: PRINT B$;: IF B$ =  CHR$(13)  THEN 1602
  132. 1642  IF A < >3  AND A < >5  AND A < >12  AND A < >16  AND A < >17  THEN 1650
  133. 1643  GET YN$: POKE  -16368,0: PRINT YN$;: IF YN$ =  CHR$(13)  THEN 1650
  134. 1644  IF YN$ < > CHR$(8)  THEN B$ = B$ +YN$: GOTO 1643
  135. 1646  IF  LEN(B$) <2  THEN B$ = "": GOTO 1643
  136. 1648 B$ =  LEFT$(B$, LEN(B$) -1): GOTO 1643
  137. 1650  IF A >1  THEN OP(A -1) =  VAL(B$): GOTO 1602
  138. 1660  INPUT "DATE?";B$: IF B$ < >""  THEN DY$ = B$
  139. 1670  GOTO 1602
  140. 1700 IX = TB +4 - LEN( STR$(X)): IF IX <0  THEN IX = 0
  141. 1702  PRINT  SPC( IX)X SPC( 2);:IX = IX + LEN( STR$(X)) +2:KK = 1: FOR JJ = 1 TO  LEN(NE$(W)): IF  MID$ (NE$(W),JJ,1) = Q$(5)  THEN E(KK) = JJ:KK = KK +1
  142. 1705  NEXT :E(0) = 0:X6 = KK -1:ID = IX: IF OP(10)  THEN 1735
  143. 1710 J = 2
  144. 1715 JJ = E(J):KK = E(J -1) +1: IF JJ -KK >0  THEN  GOSUB 1770: PRINT  MID$ (NE$(W),KK,JJ -KK)" ";
  145. 1720 J = J +1: IF J = X6 +1  THEN J = 1
  146. 1725  IF J < >2  THEN 1715
  147. 1730  GOTO 1750
  148. 1735  FOR J = 1 TO X6:JJ = E(J):KK = E(J -1) +1: IF JJ -KK >0  THEN  GOSUB 1770: PRINT  MID$ (NE$(W),KK,JJ -KK);
  149. 1740  IF J = 1  THEN  PRINT ",";
  150. 1745  PRINT " ";: NEXT 
  151. 1750 KK = E(X6) +1:JJ =  LEN(NE$(W)): IF JJ -KK >0  THEN  GOSUB 1770: PRINT  MID$ (NE$(W),KK,JJ -KK +1);
  152. 1755  PRINT : IF OP(15) >0  THEN  IF  INT(X7/OP(15)) *OP(15) = X7  THEN  PRINT :X2 = X2 +1
  153. 1760  IF  PEEK( -16384) =  ASC(CZ$) +128  THEN  POKE  -16368,0:ES = 1:X1 = LO
  154. 1765  RETURN 
  155. 1770  IF IX +JJ -KK +1 < = FC  THEN IX = IX +JJ -KK +1: RETURN 
  156. 1780  PRINT : PRINT  SPC( ID +3);:IX = ID +3: RETURN 
  157. 1800 X1 = 0:X2 = 0:X7 = 0: ONERR  GOTO 4700
  158. 1820  GOSUB 4850: INPUT LO: INPUT FL: PRINT  CHR$(4): IF OP(5)  THEN  GOSUB 2000: GOSUB 580: GOSUB 6700: GOSUB 600
  159. 1825  FOR M = 1 TO LO  STEP SZ:K = M +SZ -1: IF K >LO  THEN K = LO
  160. 1830  PRINT  CHR$(4)"READ "CP$: FOR I = M TO K: INPUT SV(I -M +1): INPUT NE$(I -M +1):NB(I -M +1) = I -M +1: PRINT "LOADING ID="SV(I -M +1)
  161. 1832  IF 10 * INT(I/10) = I  THEN  IF  PEEK( -16384) =  ASC(CZ$) +128  THEN I = LO:M = LO:ES = 1: POKE  -16368,0
  162. 1835  NEXT : PRINT  CHR$(4)
  163. 1837  IF ES  THEN 1870
  164. 1840  GOSUB 5600: IF OP(5)  THEN  GOSUB 580:IQ = 1
  165. 1850  FOR LB = 1 TO K -M +1:X = SV(LB):W = LB:X1 = X1 +1:X7 = X7 +1:X2 = X2 +1: GOSUB 1700: IF X1 = LO  THEN LB = LO:M = LO
  166. 1855  GOSUB 5700
  167. 1860  NEXT : IF OP(5)  THEN  GOSUB 600: GOTO 1870
  168. 1865  SPEED= 255
  169. 1870  NEXT : PRINT  CHR$(4)"CLOSE": IF OP(5)  THEN  GOSUB 580
  170. 1880  GOSUB 5545: POKE 216,0:LO = LO - INT((LO -1)/SZ) *SZ: RETURN 
  171. 1900 B$ = "": IF A$ = ""  THEN  RETURN 
  172. 1910  FOR I = 1 TO  LEN(A$): IF  ASC( MID$ (A$,I,1)) >95  THEN B$ = B$ + CHR$( ASC( MID$ (A$,I,1)) -32): GOTO 1930
  173. 1920 B$ = B$ + MID$ (A$,I,1)
  174. 1930  NEXT : RETURN 
  175. 2000  IF   NOT OP(5)  THEN  RETURN 
  176. 2005  IF OP(3)  THEN  GOSUB 6400: GOSUB 580:IQ = 1: GOSUB 6600: GOSUB 600:IQ = 0: RETURN 
  177. 2010 A$ = "NUMERIC": IF FL  THEN A$ = "ALPHABETIC"
  178. 2015  GOSUB 580: PRINT  SPC( OP(4))A$" LIST" SPC( 7)DY$: PRINT : GOSUB 600:X2 = X2 +2
  179. 2020  RETURN 
  180. 2100  IF LO = 0  THEN  PRINT "NO NAMES IN MEMORY": FOR I = 1 TO 2000: NEXT : RETURN 
  181. 2102  ONERR  GOTO 2180
  182. 2110  PRINT  CHR$(4)"OPEN "CP$",S"WH(DR,2)",D"WH(DR,3)
  183. 2115  PRINT  CHR$(4)"WRITE "CP$
  184. 2120  PRINT LO: PRINT FL: FOR I = 1 TO LO: IF FL  THEN  PRINT SV(NB(I)): PRINT NE$(NB(I)): GOTO 2122
  185. 2121  PRINT SV(I): PRINT NE$(I)
  186. 2122  NEXT : PRINT  CHR$(4)"CLOSE "CP$: POKE 216,0: RETURN 
  187. 2180  POKE 216,0:A =  PEEK(222): IF A = 9  THEN  PRINT "DISK FULL": GOTO 2195
  188. 2190  PRINT "ERROR # "A" ON DISKETTE READ OR WRITE"
  189. 2195  FOR I = 1 TO 5000: NEXT : GOTO 2452
  190. 2400 BB = 0: FOR I = 1 TO Q(8): IF WH(I,0) > -1  THEN  IF W >WH(I,0)  AND W < = WH(I,0) +G(2)  THEN BB = I:I = Q(8)
  191. 2410  NEXT : IF BB >0  THEN  RETURN 
  192. 2415  FOR I = 1 TO Q(8): IF WH(I,0) <0  THEN BB = I:I = Q(8)
  193. 2417  NEXT : IF BB >0  THEN 2440
  194. 2420 A = Q(28): FOR I = 1 TO Q(8): IF A >WH(I,1)  THEN A = WH(I,1):BB = I
  195. 2430  NEXT : IF BB = 0  THEN BB = 1
  196. 2440 WH(BB,1) = WH(BB,1) +1: IF IQ  THEN  GOSUB 600
  197. 2445  PRINT : PRINT "PLEASE PLACE DISKETTE NUMBER "; INT((W -1)/G(2)) +1: PRINT "INTO DRIVE "BB
  198. 2450  PRINT : PRINT "TYPE ANY KEY WHEN READY";: GOSUB 690: IF YN$ < >CZ$  AND YN$ < >"N"  THEN 2460
  199. 2452  ONERR  GOTO 2458
  200. 2455  POP : GOTO 2455
  201. 2458  POKE 216,0: GOTO 20000
  202. 2460  ONERR  GOTO 2900
  203. 2470  PRINT  CHR$(4)"OPEN CONTROLS,S"WH(BB,2)",D"WH(BB,3): PRINT  CHR$(4)"READ CONTROLS"
  204. 2480  INPUT WH(BB,0): PRINT  CHR$(4)"CLOSE": POKE 216,0: IF IQ  THEN  GOSUB 580
  205. 2490  GOTO 2400
  206. 2500  IF Q(9) >0  THEN  CALL G(0)
  207. 2510  PRINT H$(C1)" FOR ALL": PRINT "SURNAMES SOUNDING LIKE";: INPUT ":";NL$: IF NL$ = ""  THEN  RETURN 
  208. 2520 A$ = NL$: GOSUB 2700:NF$ = B$
  209. 2530  GOSUB 850: PRINT H$(C1)" FOR ALL": PRINT "SURNAMES SOUNDING LIKE "NL$: PRINT : POKE 34,3
  210. 2540 LO = 0: GOSUB 1540
  211. 2550 Z = 1: FOR XY = 1 TO Q(8): IF WH(XY,0) <0  THEN 2650
  212. 2560 W = WH(XY,0) +1: GOSUB 2400: GOSUB 3500: FOR X = WH(BB,0) +1 TO WH(BB,0) +G(2)  STEP Q(36): GOSUB 3550
  213. 2570  FOR Y = PA +1 TO PA +Q(36): INPUT NE$(Z):W = Z: GOSUB 100:A$ = N2$: GOSUB 2700: IF B$ = NF$  THEN 2620
  214. 2580  IF OP(8)  THEN  IF N3$ < >""  THEN A$ = N3$: GOSUB 2700: IF B$ = NF$  THEN 2620
  215. 2590  IF OP(13)  THEN  IF N4$ < >""  THEN A$ = N4$: GOSUB 2700: IF B$ = NF$  THEN 2620
  216. 2600  GOTO 2630
  217. 2620 SV(Z) = Y: GOSUB 800:Z = Z +1: IF Z = SZ  THEN X = Q(28):Y = X:XY = Q(8)
  218. 2630  GOSUB 640: NEXT : NEXT : PRINT  CHR$(4)"CLOSE"
  219. 2650  NEXT XY:LO = Z -1: POKE 34,0: IF ES  OR LO = 0  THEN  RETURN 
  220. 2660  ON C1 GOSUB 9510,5500: RETURN 
  221. 2700 LA =  LEN(A$):B$ = "":: IF LA = 0  THEN  RETURN 
  222. 2710 LB = 0: FOR I = 1 TO LA:A =  ASC( MID$ (A$,I,1)): GOSUB 2850: IF A = 0  THEN 2800
  223. 2712 LC = SN(A): IF   NOT AL(A)  THEN 2720
  224. 2714 CP$ =  CHR$(A +64): FOR J = 1 TO AL: IF CP$ < > LEFT$(CD$(J),1)  THEN 2719
  225. 2715  IF LA -I <CD(J,1)  THEN 2719
  226. 2716 M = 1: FOR K = 2 TO CD(J,1):A =  ASC( MID$ (A$,I +K -1,1)): GOSUB 2850: IF A = 0  THEN K = 9:M = 0: GOTO 2718
  227. 2717  IF  CHR$(A +64) < > MID$ (CD$(J),K,1)  THEN M = 0
  228. 2718  NEXT : IF M  THEN LC = CD(J,2):J = AL:I = I +CD(J,1) -1
  229. 2719  NEXT 
  230. 2720  IF I = 1  THEN 2740
  231. 2725  IF LC = 0  THEN 2800
  232. 2730  IF LB >0  THEN  IF  ASC( MID$ (B$,LB,1)) = LC +48  THEN 2800
  233. 2740 B$ = B$ + CHR$(LC +48):LB = LB +1: GOTO 2800
  234. 2800  NEXT : IF  LEN(B$) >4  THEN B$ =  LEFT$(B$,4)
  235. 2810  RETURN 
  236. 2850  IF A >64  AND A <91  THEN A = A -64: RETURN 
  237. 2860  IF A >96  AND A <123  THEN A = A -96: RETURN 
  238. 2870 A = 0: RETURN 
  239. 2900  POKE 216,0: CALL G(8): PRINT : PRINT "THAT WAS NOT A DATA DISKETTE.": PRINT "PLEASE TRY AGAIN...";: GOSUB 690: PRINT  CHR$(4)"OPEN CONTROLS": PRINT  CHR$(4)"READ CONTROLS": RESUME 
  240. 3000  IF Q(8) = 1  THEN BB = 1: GOTO 3015
  241. 3002 BB = 0:A = 0: FOR I = 1 TO Q(8): IF WH(I,0) > -1  THEN BB = I:A = A +1
  242. 3003  NEXT : IF A = 1  THEN 3020
  243. 3005  PRINT : PRINT "WHICH DRIVE (1-"Q(8)")?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN  RETURN 
  244. 3010 BB =  VAL(YN$): IF BB <1  OR BB >Q(8)  THEN 3005
  245. 3015  IF WH(BB,0) > -1  THEN 3020
  246. 3016  IF Q(8) = 1  THEN  RETURN 
  247. 3017  PRINT "THE DRIVE DOESN'T HAVE A DATA DISKETTE": GOTO 3005
  248. 3020 Z = 0: GOSUB 3500: FOR X = WH(BB,0) +1 TO WH(BB,0) +G(2)  STEP Q(36): GOSUB 3550: FOR Y = PA +1 TO PA +Q(36):Z = Z +1:SV(Z) = Y: INPUT NE$(Z): GOSUB 800: IF Z >SZ -2  THEN Y = Q(28):X = Y: PRINT Z" NAMES STORED": FOR I = 1 TO 2000: NEXT 
  249. 3030  NEXT : GOSUB 640: NEXT : PRINT  CHR$(4)"CLOSE":LO = Z: IF ES  OR LO = 0  THEN  RETURN 
  250. 3040  ON C1 GOSUB 9510,5500: RETURN 
  251. 3500  PRINT  CHR$(4)"OPEN NAMELIST,S"WH(BB,2)",D"WH(BB,3)",L"Q(36) *Q(14) +Q(38): RETURN 
  252. 3550  ONERR  GOTO 3580
  253. 3560 OB =  INT((X -WH(BB,0) -1)/Q(36)) +1: PRINT  CHR$(4)"READ NAMELIST,R"OB: INPUT PA: INPUT LN:PA = PA +WH(BB,0): POKE 216,0: RETURN 
  254. 3580  POKE 216,0:A =  PEEK(222): IF A < >5  THEN 2190
  255. 3590  PRINT "NO DATA DISKETTE IN DRIVE "BB: GOTO 2195
  256. 4000  GOSUB 850:A = (Q(22) - LEN(H2$(C2)))/2: HTAB A: INVERSE : PRINT H2$(C2): NORMAL 
  257. 4005  IF Q(8) = 1  THEN D1 = 1: GOTO 4030
  258. 4010  PRINT : PRINT "WHICH DRIVE HAS THE FIRST LIST (1-"Q(8)")?";: GOSUB 690: IF YN$ =  CHR$(13)  OR YN$ = CZ$  THEN  RETURN 
  259. 4020 D1 =  VAL(YN$): IF D1 <1  OR D1 >Q(8)  THEN 4010
  260. 4030 A$ = "READ FROM":DR = D1: GOSUB 4800:DP$ = CP$
  261. 4035  IF Q(8) = 1  THEN DR = 1: GOTO 4060
  262. 4040  PRINT : PRINT "WHICH DRIVE HAS THE SECOND LIST (1-"Q(8)")?";: GOSUB 690: IF YN$ =  CHR$(13)  OR YN$ = CZ$  THEN  RETURN 
  263. 4050 DR =  VAL(YN$): IF DR <1  OR DR >Q(8)  THEN 4040
  264. 4060 D2 = DR: GOSUB 4800:T$ = CP$
  265. 4065  IF   NOT OP(6)  THEN 4095
  266. 4070  IF Q(8) = 1  THEN DR = 1: GOTO 4085
  267. 4075  PRINT : PRINT "ON WHICH DRIVE SHOULD THE MERGED LIST": PRINT "BE SAVED (1-"Q(8)")?";: GOSUB 690: IF YN$ =  CHR$(13)  OR YN$ = CZ$  THEN  RETURN 
  268. 4080 DR =  VAL(YN$): IF DR <1  OR DR >Q(8)  THEN 4075
  269. 4085 A$ = "SAVED TO":D3 = DR: GOSUB 4800:FM$ = CP$
  270. 4095  GOSUB 4100: RETURN 
  271. 4100 FL = 1: GOSUB 2000
  272. 4105  PRINT  CHR$(4)"OPEN "DP$",S"WH(D1,2)",D"WH(D1,3): PRINT  CHR$(4)"OPEN "T$",S"WH(D2,2)",D"WH(D2,3): IF OP(6)  THEN  PRINT  CHR$(4)"OPEN "FM$",S"WH(D3,2)",D"WH(D3,3)
  273. 4107 DR = D1: ONERR  GOTO 4700
  274. 4110  PRINT  CHR$(4)"READ "DP$: INPUT LO: INPUT FL: INPUT Y: INPUT NE$(1): PRINT  CHR$(4)
  275. 4115  IF FL <1  THEN  PRINT "NAMES IN "DP$" AREN'T ALPHABETIZED.": FOR I = 1 TO 2000: NEXT : GOTO 4400
  276. 4117 DR = D2: ONERR  GOTO 4700
  277. 4120  PRINT  CHR$(4)"READ "T$: INPUT LN: INPUT FL: INPUT Z: INPUT NE$(2): PRINT  CHR$(4)
  278. 4125  IF FL <1  THEN  PRINT "NAMES IN "T$" AREN'T ALPHABETIZED.": FOR I = 1 TO 2000: NEXT : GOTO 4400
  279. 4127  ONERR  GOTO 2180
  280. 4130  IF OP(6)  THEN  PRINT  CHR$(4)"WRITE "FM$: PRINT LO +LN: PRINT FL: PRINT  CHR$(4)
  281. 4150 X1 = 0:X2 = 0:X7 = 0:X3 = 1:X4 = 1: GOSUB 5600: IF OP(5)  THEN  GOSUB 580: GOSUB 6700
  282. 4160 X = Y:W = 1: IF NE$(1) >NE$(2)  THEN X = Z:W = 2
  283. 4200  GOSUB 4410: IF ES  THEN 4400
  284. 4225  IF W = 2  THEN 4300
  285. 4230  IF X3 = LO  THEN 4340
  286. 4240  GOSUB 4480: GOTO 4160
  287. 4300  IF X4 = LN  THEN 4320
  288. 4310  GOSUB 4490: GOTO 4160
  289. 4320 X = Y:W = 1: GOSUB 4410: IF ES  OR X3 = LO  THEN 4400
  290. 4330  GOSUB 4480: GOTO 4320
  291. 4340 X = Z:W = 2: GOSUB 4410: IF ES  OR X4 = LN  THEN 4400
  292. 4350  GOSUB 4490: GOTO 4340
  293. 4400  PRINT  CHR$(4)"CLOSE":LO = 0: GOSUB 5545: POKE 216,0: RETURN 
  294. 4410 X1 = X3 +X4:X2 = X2 +1:X7 = X7 +1: GOSUB 1700
  295. 4430  GOSUB 5700
  296. 4450  IF OP(6)  THEN  PRINT  CHR$(4)"WRITE "FM$: PRINT X: PRINT NE$(W): PRINT  CHR$(4)
  297. 4460  IF 10 * INT(X1/10) = X1  THEN  IF  PEEK( -16384) =  ASC(CZ$) +128  THEN ES = 1: POKE  -16368,0
  298. 4470  RETURN 
  299. 4480  PRINT  CHR$(4)"READ "DP$: INPUT Y: INPUT NE$(1): PRINT  CHR$(4):X3 = X3 +1: RETURN 
  300. 4490  PRINT  CHR$(4)"READ "T$: INPUT Z: INPUT NE$(2): PRINT  CHR$(4):X4 = X4 +1: RETURN 
  301. 4500  GOSUB 850:A = (Q(22) - LEN(H2$(C2)))/2: HTAB A: INVERSE : PRINT H2$(C2): NORMAL 
  302. 4505 A$ = "LOADED FROM": IF C2 = 2  THEN A$ = "READ FROM"
  303. 4506  IF C2 = 4  THEN A$ = "SAVED TO"
  304. 4508  IF Q(8) = 1  THEN DR = 1: GOTO 4550
  305. 4510  PRINT : PRINT "WHICH DRIVE IS THE LIST TO BE": PRINT A$" (1-"Q(8)")?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN  RETURN 
  306. 4520 DR =  VAL(YN$): IF DR <1  OR DR >Q(8)  THEN 4510
  307. 4550  GOSUB 4800: IF CP$ = CZ$  THEN  RETURN 
  308. 4560  ON C2 -1 GOSUB 1800,4600,2100: RETURN 
  309. 4600  ONERR  GOTO 4700
  310. 4610  GOSUB 4850
  311. 4620  INPUT LO: IF LO >SZ  THEN  PRINT "LIST TOO BIG FOR MEMORY. ONLY "SZ" OUT": PRINT "OF "LO" NAMES WILL BE STORED.":LO = SZ
  312. 4630  INPUT FL: FOR I = 1 TO LO: INPUT SV(I): INPUT NE$(I): IF I = 10 * INT(I/10)  THEN  IF  PEEK( -16384) =  ASC(CZ$) +128  THEN I = LO:ES = 1: POKE  -16368,0
  313. 4650 NB(I) = I: NEXT : PRINT  CHR$(4)"CLOSE": POKE 216,0: RETURN 
  314. 4700  POKE 216,0:A =  PEEK(222): IF A < >5  THEN 2190
  315. 4710  PRINT : PRINT "FILE NOT FOUND. PROBABLY MISSPELLED.": GOSUB 4800: GOSUB 4850: ONERR  GOTO 4700
  316. 4720  RESUME 
  317. 4800 BB$ = "CATALOG": IF Q(9) = 1  THEN BB$ = "CAT"
  318. 4810  PRINT : PRINT "WHAT IS THE NAME OF FILE ON THE DIS-": PRINT "KETTE THE LIST WILL BE "A$;: INPUT CP$
  319. 4820  IF CP$ = ""  THEN  PRINT  CHR$(4)BB$",S"WH(DR,2)",D"WH(DR,3): GOTO 4810
  320. 4825  IF CP$ = CZ$  THEN 2452
  321. 4830  RETURN 
  322. 4849 :
  323. 4850  PRINT  CHR$(4)"OPEN "CP$",S"WH(DR,2)",D"WH(DR,3): PRINT  CHR$(4)"READ "CP$: RETURN 
  324. 5000  GOSUB 850:A = (Q(22) - LEN(H2$(C2)))/2: HTAB A: INVERSE : PRINT H2$(C2): NORMAL : PRINT 
  325. 5010 LO = 0: FOR XY = 1 TO Q(8):Z = 0: IF WH(XY,0) <0  THEN 5200
  326. 5020 W = WH(XY,0) +1: GOSUB 2400: GOSUB 3500
  327. 5030  FOR X = WH(BB,0) +1 TO WH(BB,0) +G(2)  STEP Q(36): GOSUB 3550: FOR Y = PA +1 TO PA +Q(36): INPUT A$
  328. 5040  IF  LEN(A$) <4  THEN  IF Z <SZ  THEN Z = Z +1:SV(Z) = Y
  329. 5050  NEXT : GOSUB 640: NEXT : PRINT  CHR$(4)"CLOSE": IF ES  THEN 5200
  330. 5052  IF Z = 0  THEN  PRINT "THERE ARE NO EMPTY SLOTS ON DISKETTE "WH(XY,0)/G(2) +1".": FOR I = 1 TO 2000: NEXT : GOTO 5200
  331. 5055  IF OP(5)  THEN  GOSUB 580:IQ = 1
  332. 5060  PRINT : PRINT  SPC( TB)"EMPTY NAME SLOTS FOR DATA DISKETTE": PRINT  SPC( TB)"NUMBER "WH(XY,0)/G(2) +1" ARE AS FOLLOWS:": PRINT 
  333. 5065 M = 10: IF   NOT OP(5)  THEN M = 6: SPEED=  INT(OP(11) *2.55)
  334. 5070  FOR J = 1 TO Z  STEP M: PRINT  SPC( TB);:K = J +M -1: IF K >Z  THEN K = Z
  335. 5080  FOR I = J TO K: PRINT  SPC( 6 - LEN( STR$(SV(I))))SV(I);: NEXT : PRINT 
  336. 5100  NEXT : IF OP(5)  THEN  GOSUB 600:IQ = 0
  337. 5200  NEXT : IF OP(5)  AND OP(1)  AND Z >0  THEN  GOSUB 580: PRINT  CHR$(12): GOSUB 600
  338. 5205  IF   NOT OP(5)  THEN  GOSUB 695: SPEED= 255
  339. 5210  RETURN 
  340. 5500  IF LO = 0  THEN  PRINT "NOTHING IN MEMORY": FOR I = 1 TO 2000: NEXT : RETURN 
  341. 5510  GOSUB 5600:X2 = 0:X7 = 0: GOSUB 2000: IF OP(5)  THEN  GOSUB 580:IQ = 1
  342. 5520  GOSUB 6700: FOR X1 = 1 TO LO:X2 = X2 +1:X7 = X7 +1:X = SV(X1):W = X1: GOSUB 1700
  343. 5530  GOSUB 5700
  344. 5540  NEXT : GOSUB 5545: RETURN 
  345. 5545  IF OP(1)  AND OP(5)  THEN  PRINT  CHR$(12)
  346. 5550  PRINT : IF OP(5)  THEN  GOSUB 600:IQ = 0
  347. 5555  IF   NOT OP(5)  THEN  GOSUB 695: SPEED= 255
  348. 5570  RETURN 
  349. 5600  IF   NOT OP(5)  THEN  SPEED=  INT(2.55 *OP(11))
  350. 5605  RETURN 
  351. 5700  IF   NOT OP(5)  THEN  RETURN 
  352. 5705  IF X2 <OP(16)  OR OP(16) = 0  OR (X1 = LO  AND C1 < >3  AND C2 < >1)  THEN  RETURN 
  353. 5710  IF OP(15) >0  THEN  IF (OP(15) <9  AND  INT(X7/OP(15)) *OP(15) < >X7)  THEN  RETURN 
  354. 5720  PRINT  CHR$(12):X2 = 0: GOSUB 6700:X7 = 0: RETURN 
  355. 6000  DIM G$(Q(18)),E(3)
  356. 6040  DIM H$(7),H1$(5),H2$(8)
  357. 6047  IF Q(9) = 1  THEN G(0) = 25
  358. 6049  IF Q(9) = 2  THEN G(0) =  PEEK(115) +256 * PEEK(116) +12
  359. 6050  IF Q(9) >0  THEN  CALL G(0)
  360. 6070 X =  FRE(0):SZ =  INT((X -1000)/(Q(14) +13))
  361. 6075  DIM NE$(SZ),SV(SZ),NB(SZ)
  362. 6130 CZ$ = Q$(22): RETURN 
  363. 6400  GOSUB 850: PRINT : INVERSE : PRINT "DEFINING HEADER:": NORMAL : PRINT : POKE 34,3: IF Q(9) >0  THEN  CALL G(0)
  364. 6402  IF R >0  THEN  PRINT "USE PREVIOUSLY DEFINED HEADER?";: GOSUB 690: PRINT :OP(3) = (YN$ < >CZ$): IF YN$ = "Y"  OR YN$ = CZ$  THEN  POKE 34,0: RETURN 
  365. 6410 R = 0: INPUT "HOW MANY BLANK LINES AT THE TOP?";YN$: IF YN$ = ""  THEN 6450
  366. 6420 R =  VAL(YN$): IF R <0  THEN R = 0
  367. 6430  IF R >Q(18) -2  THEN 6410
  368. 6440  IF R >0  THEN  FOR I = 1 TO R:G$(I) = "": NEXT 
  369. 6450  PRINT : PRINT "TYPE UP TO "Q(18) -R" LINES.  USE 'RETURN'": PRINT "TO END:"
  370. 6460  PRINT :R = R +1: PRINT "LINE "R;: INPUT ": ";G$(R): IF G$(R) < >""  AND R <Q(18) -1  THEN 6460
  371. 6470 R = R -1: PRINT : INPUT "HOW MANY BLANK LINES TO FOLLOW?";YN$: IF YN$ = ""  THEN R = R +1:G$(R) = "": GOTO 6510
  372. 6480 A =  VAL(YN$): IF A <0  THEN 6510
  373. 6490  IF A >Q(18) -R  THEN A = Q(18) -R
  374. 6500  IF A >0  THEN  FOR I = R +1 TO R +A:G$(I) = "": NEXT :R = R +A
  375. 6510  GOSUB 850: PRINT "YOUR HEADER IS:": PRINT : FOR X5 = 1 TO R: PRINT "LINE "X5": ";:K = 7: GOSUB 6610: NEXT 
  376. 6520  PRINT : PRINT "IS IT O.K.?";: GOSUB 690: IF YN$ < > CHR$(13)  AND YN$ < >"Y"  THEN  GOSUB 850: GOTO 6410
  377. 6530  PRINT : PRINT "SET PARAMETERS (DON'T FORGET THE TAB)?";: GOSUB 690: POKE 34,0: IF YN$ = "Y"  OR YN$ = "P"  THEN  GOSUB 1600
  378. 6540  RETURN 
  379. 6600  IF R = 0  THEN  RETURN 
  380. 6605 LC = R: FOR X5 = 1 TO R: PRINT  SPC( OP(4));:X2 = X2 +1:K = OP(4): GOSUB 6610: NEXT : RETURN 
  381. 6610  IF  LEN(G$(X5)) +K < = FC  THEN  PRINT G$(X5): RETURN 
  382. 6630 J = 0: FOR I = FC -K TO 1  STEP  -1: IF  MID$ (G$(X5),I,1) = " "  OR  MID$ (G$(X5),I,1) = "-"  THEN J = I:I = 1
  383. 6635  NEXT : IF J >0  AND J < LEN(G$(X5))  THEN  PRINT  LEFT$(G$(X5),J): PRINT  SPC( (IQ >0) *OP(4) +2) RIGHT$(G$(X5), LEN(G$(X5)) -J):LC = LC +1: RETURN 
  384. 6640  PRINT G$(X5): RETURN 
  385. 6699 :
  386. 6700  GOSUB 850:PG = PG +1: PRINT : PRINT  SPC( TB)"RECORD": PRINT  SPC( TB)"INDEX" SPC( 4)"NAME";: IF OP(16) >0  THEN  PRINT  SPC( 58 -TB)"PAGE "PG;
  387. 6710  PRINT : PRINT :X2 = X2 +4: RETURN 
  388. 6760  GOSUB 850: PRINT : PRINT "1) RUN A DIFFERENT PROGRAM": PRINT "2) CHECK FREE SPACE": PRINT "3) RETURN TO 'LISTS'": PRINT "4) END SESSION"
  389. 6762  PRINT : INVERSE : PRINT "CHOICE (1-4)?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN  GOTO 6780
  390. 6763 C1 =  VAL(YN$): IF C1 <1  OR C1 >4  THEN 6762
  391. 6764  IF C1 = 4  THEN  PRINT : PRINT Q$(21): PRINT "BYE...": END 
  392. 6765  ON C1 GOTO 6780,6770,20000
  393. 6770  PRINT "FREE SPACE=" FRE(0): GOSUB 690: GOTO 6760
  394. 6780 A = 0:X =  -1: FOR I = 1 TO Q(8): IF WH(I,0) =  -3  THEN A = A +1:X = I
  395. 6781  NEXT : IF A = 1  THEN 6783
  396. 6782  POKE 216,0:X = Q(29)
  397. 6783  GOSUB 850: IF YN$ = CZ$  THEN  PRINT  CHR$(4)"PR#"Q(43): GOTO 6760
  398. 6784  IF Q(40)  THEN  PRINT  CHR$(21)
  399. 6785 A = WH(X,2): GOSUB 7100: PRINT "LOADING NEXT MODULE"
  400. 6787  ONERR  GOTO 6782
  401. 6790  PRINT  CHR$(4)"RUN DIMMER,S"A",D"WH(X,3)
  402. 6795 X = 1: GOSUB 850: RETURN 
  403. 7100  GOSUB 850: FOR I = 1 TO 7: PRINT : NEXT : INVERSE : PRINT "PLEASE WAIT";: NORMAL : PRINT "...": PRINT : PRINT  SPC( 14);: RETURN 
  404. 8030 A =  PEEK(103) +256 * PEEK(104):II =  PEEK(A) +256 * PEEK(A +1):JJ =  PEEK(A +2) +256 * PEEK(A +3): IF JJ < >0  OR II -A < >71  THEN  NEW 
  405. 8040  RETURN 
  406. 8100 PG = 0: GOSUB 850: HTAB (Q(22) -13)/2: INVERSE : PRINT "SPECIAL LISTS": NORMAL : PRINT 
  407. 8110  PRINT "DO YOU WANT TO:": PRINT : FOR I = 1 TO H2: PRINT I") "H2$(I): NEXT 
  408. 8120  PRINT : INVERSE : PRINT "CHOICE (1-"H2",P)?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN  RETURN 
  409. 8125  IF YN$ = "P"  THEN  GOSUB 1600: GOTO 8100
  410. 8130 C2 =  VAL(YN$): IF C2 <1  OR C2 >H2  THEN 8120
  411. 8160 ES = 0: ON C2 GOSUB 4000,4500,4500,4500,9300,8200,5000: GOTO 8100
  412. 8200  IF FL = 0  THEN  GOSUB 5500: RETURN 
  413. 8210  IF OP(3)  THEN  GOSUB 6400
  414. 8220  GOSUB 9950: RETURN 
  415. 9000  DATA 6
  416. 9020  DATA MAKE ALPHABETIC LIST,MAKE NUMERIC ORDER LIST,MAKE SPECIAL LIST,CHANGE PROGRAM PARAMETERS,CHECK DISKETTES,"EXIT PROGRAM"
  417. 9040  DATA 5
  418. 9060  DATA  NUMBER RANGE,NUMBER LIST,NAME SET,SURNAME SOUNDEX,WHOLE DISKETTE 
  419. 9090  DATA 7
  420. 9095  DATA MERGE ALPHABETIC LISTS,SHOW LIST FROM DISKETTE,PUT DISKETTE LIST INTO MEMORY,SAVE LIST TO DISKETTE,ALPHABETIZE MEMORY LIST,REPEAT A LIST,LIST EMPTY SLOTS
  421. 9100  DATA 16
  422. 9101  DATA TOP-OF-FORM AFTER PRINTS
  423. 9102  DATA SIZE OF LEFT MARGIN
  424. 9103  DATA ASK FOR HEADER
  425. 9104  DATA TAB BEFORE HEADER
  426. 9105  DATA OUTPUT TO PRINTER
  427. 9106  DATA SAVE LIST ON DISKETTE
  428. 9107  DATA USE MAIDEN NAME
  429. 9108  DATA USE MARRIED NAME
  430. 9109  DATA SHOW EMPTY NAME SLOTS
  431. 9110  DATA SHOW LAST NAME FIRST
  432. 9111  DATA SCREEN SPEED (1-100%)
  433. 9112  DATA ABLE TO ABORT ALPHA
  434. 9113  DATA SEARCH TITLE WITH SOUNDEX
  435. 9114  DATA IGNORE UPPER/LOWER CASE
  436. 9115  DATA NAMES PER GROUP
  437. 9116  DATA LINES PER PAGE
  438. 9200  DATA 0,1,2,3,0,1,2,0,0,0,2,4,5,5,0,1,2,6,2,3,0,1,0,2,0,2
  439. 9210  DATA 0,0,0,1,0,0,1,0,1,0,0,0,0,1,0,0,0,0,0,1,0,0,1,0,0,0
  440. 9220  DATA 9
  441. 9230  DATA 2,1,TH,2,5,NG,3,2,TIO,2,2,DG,3,0,IGH,3,3,GHT,2,1,GH,2,6,WR,2,5,GN
  442. 9300  IF FL = 0  THEN LA = OP(5):OP(5) = 0: GOSUB 9510:OP(5) = LA: RETURN 
  443. 9310  PRINT "LIST IN MEMORY IS ALREADY ALPHABETIC.": FOR I = 1 TO 2000: NEXT : RETURN 
  444. 9510  GOSUB 850: IF LO = 0  THEN  PRINT "NOTHING IN MEMORY": FOR I = 1 TO 2000: NEXT : RETURN 
  445. 9515 FL = 1: GOSUB 850: IF OP(3)  AND OP(5)  THEN  GOSUB 6400
  446. 9518  GOSUB 7100: PRINT "INITIALIZING ARRAYS"
  447. 9520 I = 1:II = LO: FOR J = 1 TO LO:NB(J) = J: NEXT : IF   NOT OP(9)  THEN II = LO: GOTO 9580
  448. 9530  IF  LEN(NE$(NB(I))) >3  THEN 9560
  449. 9540  GOSUB 400:II = II -1: IF I > = II  THEN 9570
  450. 9550  GOTO 9530
  451. 9560 I = I +1: IF I <II  THEN 9530
  452. 9570  IF  LEN(NE$(NB(II))) <4  THEN II = II -1
  453. 9580 NB = II: IF NB <2  THEN  GOSUB 9950: RETURN 
  454. 9590  GOSUB 850: INVERSE : PRINT "ALPHABETIZING NAMELIST.": NORMAL 
  455. 9600 DR =  INT(.003 *NB ^1.5)/10
  456. 9610  PRINT : PRINT "THIS MAY TAKE ";DR;" MINUTES TO FINISH"
  457. 9620  VTAB 17: PRINT "'ID' IS ONE LESS THAN A POWER OF 2 AND " CHR$((Q(43) = 0) *13)"DECREMENTS.  PROCESSING IS DONE WHEN IT": PRINT "IS FINISHED WITH ID=1.  ID=1 USES " CHR$((Q(43) = 0) *13)"ABOUT 1/3 OF THE TOTAL TIME."
  458. 9630  GOSUB 410: RETURN 
  459. 9950  GOSUB 850: IF C2 = 5  THEN  RETURN 
  460. 9952  IF LO = 0  THEN  PRINT "NOTHING IN MEMORY": FOR I = 1 TO 2000: NEXT : RETURN 
  461. 9955  GOSUB 5600:X2 = 0:X7 = 0: IF   NOT OP(5)  THEN 10010
  462. 9960  INVERSE : PRINT "PLEASE READY THE PRINTER": NORMAL : GOSUB 580:IQ = 1
  463. 9980  IF OP(3)  THEN  GOSUB 6600: GOTO 10010
  464. 9995  PRINT  SPC( OP(4))"ALPHABETIC INDEX" SPC( 7)DY$
  465. 10010  GOSUB 6700: FOR X1 = 1 TO LO:X2 = X2 +1:X7 = X7 +1:X = SV(NB(X1)):W = NB(X1)
  466. 10090  GOSUB 1700
  467. 10092  GOSUB 5700
  468. 10095  NEXT : GOSUB 5545: RETURN 
  469. 12500  IF   NOT Q(2)  THEN DY$ = Q$(3): RETURN 
  470. 12505  PRINT  CHR$(4)"IN#"Q(5): PRINT  CHR$(4)"PR#"Q(5): PRINT Q$(7);: INPUT DY$: PRINT  CHR$(4)"IN#0": IF Q(13)  THEN A$ =  MID$ (DY$,Q(13),Q(21))
  471. 12510 DY$ =  MID$ (DY$,Q(11),Q(12) -Q(11) +1): IF   NOT Q(13)  THEN DY$ = DY$ +"/" +Q$(3)
  472. 12520  IF Q(13)  THEN DY$ = DY$ +"/" +A$
  473. 12530  IF Q(25)  THEN DY$ =  MID$ (DY$,4,3) + MID$ (DY$,1,3) + RIGHT$(DY$,4)
  474. 12540  PRINT  CHR$(4)"PR#"Q(43): RETURN 
  475. 16000  GOSUB 16500: GOSUB 6000: READ H: FOR I = 1 TO H: READ H$(I): NEXT : GOSUB 850: PRINT  CHR$(4)"PR#"Q(43)
  476. 16070  READ H1: FOR I = 1 TO H1: READ H1$(I): NEXT 
  477. 16075  READ H2: FOR I = 1 TO H2: READ H2$(I): NEXT 
  478. 16080  READ OP: FOR I = 1 TO OP: READ OP$(I): NEXT : GOSUB 8030
  479. 16081  DIM SN(26),AL(26): FOR I = 1 TO 26: READ SN(I): NEXT : FOR I = 1 TO 26: READ AL(I): NEXT : READ AL
  480. 16082  DIM CD(AL,2),CD$(AL): FOR I = 1 TO AL: READ CD(I,1): READ CD(I,2): READ CD$(I): NEXT 
  481. 16084 R = 0:FC = Q(22): GOSUB 12500:B$ = "":A$ = "IS": IF Q(8) >1  THEN B$ = "S":A$ = "ARE"
  482. 16085  GOSUB 850: GOTO 18000
  483. 16090 ES = 0: GOSUB 850: HTAB (Q(22) -22)/2: INVERSE : PRINT "LISTS-OF-NAMES PROGRAM": NORMAL : PRINT : PRINT "WHICH DO YOU WANT TO DO:": PRINT 
  484. 16100 C2 = 0: FOR X = 1 TO H: PRINT X") "H$(X): NEXT 
  485. 16120  PRINT : INVERSE : PRINT "CHOICE (1-"H")?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN 6760
  486. 16125 C1 =  VAL(YN$): IF C1 <1  OR C1 >H  THEN 16120
  487. 16130  PRINT : IF C1 = H  THEN 6760
  488. 16135  IF C1 = H -1  THEN 18000
  489. 16140  GOSUB 680: ON C1 GOSUB 16170,16170,8100,1600: GOTO 16090
  490. 16170 PG = 0:FL = 0: PRINT : PRINT H$(C1)" BY:": PRINT 
  491. 16180  FOR X = 1 TO H1: PRINT X") "H1$(X): NEXT : PRINT 
  492. 16200  INVERSE : PRINT "CHOICE (1-"H1",P)?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN  RETURN 
  493. 16202  IF YN$ = "P"  THEN  GOSUB 1600: GOSUB 850: GOTO 16170
  494. 16205 C3 =  VAL(YN$): IF C3 <1  OR C3 >H1  THEN 16200
  495. 16210  PRINT : ON C3 GOSUB 1000,740,1260,2500,3000
  496. 16260  RETURN 
  497. 16500  ONERR  GOTO 16700
  498. 16505  DIM Q(44),Q$(22),OP(17),OP$(17),G(10):G(8) =  PEEK(115) +256 * PEEK(116) +1
  499. 16510  PRINT  CHR$(4)"OPEN CONFIGURATION": PRINT  CHR$(4)"READ CONFIGURATION": FOR I = 1 TO 44: INPUT Q(I): NEXT 
  500. 16512  FOR I = 1 TO 4: INPUT A: NEXT : DIM WH(6,3): FOR I = 1 TO 6: FOR J = 2 TO 3: INPUT WH(I,J): NEXT : NEXT : FOR I = 1 TO 4: INPUT A: NEXT 
  501. 16515  IF Q(43)  THEN Q(9) = 0
  502. 16520  FOR I = 1 TO 22
  503. 16522 J = 0: GET A$: IF A$ =  CHR$(127)  THEN A$ =  CHR$(0)
  504. 16523  IF A$ =  CHR$(126)  THEN A$ =  CHR$(13):J = 1
  505. 16525  IF A$ < > CHR$(13)  OR J = 1  THEN Q$(I) = Q$(I) +A$: GOTO 16522
  506. 16530  NEXT : FOR I = 1 TO 18: INPUT A$: NEXT : FOR I = 1 TO 17: INPUT A: NEXT 
  507. 16535  INPUT OP(1): INPUT OP(2): FOR I = 1 TO 9: INPUT A: NEXT : INPUT OP(3): FOR I = 1 TO 7: INPUT A: NEXT : FOR I = 4 TO 13: INPUT OP(I): NEXT : INPUT OP(15): INPUT A: INPUT OP(14): FOR I = 1 TO 13: INPUT OP(16): NEXT 
  508. 16545  PRINT  CHR$(4)"CLOSE"
  509. 16550  POKE 216,0: RETURN 
  510. 16700 A =  PEEK(222): CALL G(8): IF A = 5  OR A = 6  OR A = 8  THEN  PRINT "NO CONFIGURATION FILE AVAILABLE ON": PRINT "DISKETTE LAST USED. PLEASE SEE MANUAL.": END 
  511. 16720  PRINT "ERROR # "A". PLEASE SEE DOS MANUAL.": END 
  512. 18000  FOR I = 1 TO Q(8)
  513. 18035  ONERR  GOTO 18200
  514. 18040  PRINT  CHR$(4)"OPEN CONTROLS,S"WH(I,2)",D"WH(I,3): PRINT  CHR$(4)"READ CONTROLS": FOR J = 1 TO 7: INPUT G(J): NEXT : PRINT  CHR$(4)"CLOSE"
  515. 18050  IF G(3) = Q(14)  AND G(4) = Q(15)  AND G(5) = Q(16)  AND G(6) = Q(36)  AND G(7) = Q(38)  THEN 18100
  516. 18060  PRINT : PRINT "DISKETTE IN SLOT "WH(I,2)", DRIVE "A",": PRINT "DOES NOT MATCH THE CONFIGURATION FILE.": PRINT "PLEASE REFER TO MANUAL.": END 
  517. 18100 WH(I,0) = G(1): NEXT : POKE 216,0: GOTO 18215
  518. 18200  POKE 216,0: CALL G(8):WH(I,0) =  -1
  519. 18205  PRINT "THE DISKETTE IN DRIVE "I" IS ASSUMED": PRINT "TO BE A SCRATCH ONE.": FOR BB = 1 TO 2000: NEXT 
  520. 18210  NEXT I
  521. 18215 J = 0: FOR I = 1 TO Q(8): IF WH(I,0) <0  THEN J = J +1
  522. 18220  NEXT : IF J = Q(8)  THEN  PRINT "NO DATA DISKETTES LOADED.": FOR BB = 1 TO 5000: NEXT 
  523. 20000  GOTO 16090